home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / perl / os2perl / consarg.c < prev    next >
C/C++ Source or Header  |  1991-06-11  |  29KB  |  1,247 lines
  1. /* $RCSfile: consarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:33:12 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    consarg.c,v $
  9.  * Revision 4.0.1.2  91/06/07  10:33:12  lwall
  10.  * patch4: new copyright notice
  11.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  12.  *
  13.  * Revision 4.0.1.1  91/04/11  17:38:34  lwall
  14.  * patch1: fixed "Bad free" error
  15.  *
  16.  * Revision 4.0  91/03/20  01:06:15  lwall
  17.  * 4.0 baseline.
  18.  *
  19.  */
  20.  
  21. #include "EXTERN.h"
  22. #include "perl.h"
  23. static int nothing_in_common();
  24. static int arg_common();
  25. static int spat_common();
  26.  
  27. ARG *
  28. make_split(stab,arg,limarg)
  29. register STAB *stab;
  30. register ARG *arg;
  31. ARG *limarg;
  32. {
  33.     register SPAT *spat;
  34.  
  35.     if (arg->arg_type != O_MATCH) {
  36.     Newz(201,spat,1,SPAT);
  37.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  38.     curstash->tbl_spatroot = spat;
  39.  
  40.     spat->spat_runtime = arg;
  41.     arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  42.     }
  43.     Renew(arg,4,ARG);
  44.     arg->arg_len = 3;
  45.     if (limarg) {
  46.     if (limarg->arg_type == O_ITEM) {
  47.         Copy(limarg+1,arg+3,1,ARG);
  48.         limarg[1].arg_type = A_NULL;
  49.         arg_free(limarg);
  50.     }
  51.     else {
  52.         arg[3].arg_flags = 0;
  53.         arg[3].arg_type = A_EXPR;
  54.         arg[3].arg_ptr.arg_arg = limarg;
  55.     }
  56.     }
  57.     else
  58.     arg[3].arg_type = A_NULL;
  59.     arg->arg_type = O_SPLIT;
  60.     spat = arg[2].arg_ptr.arg_spat;
  61.     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
  62.     if (spat->spat_short) {    /* exact match can bypass regexec() */
  63.     if (!((spat->spat_flags & SPAT_SCANFIRST) &&
  64.         (spat->spat_flags & SPAT_ALL) )) {
  65.         str_free(spat->spat_short);
  66.         spat->spat_short = Nullstr;
  67.     }
  68.     }
  69.     return arg;
  70. }
  71.  
  72. ARG *
  73. mod_match(type,left,pat)
  74. register ARG *left;
  75. register ARG *pat;
  76. {
  77.  
  78.     register SPAT *spat;
  79.     register ARG *newarg;
  80.  
  81.     if (!pat)
  82.     return Nullarg;
  83.  
  84.     if ((pat->arg_type == O_MATCH ||
  85.      pat->arg_type == O_SUBST ||
  86.      pat->arg_type == O_TRANS ||
  87.      pat->arg_type == O_SPLIT
  88.     ) &&
  89.     pat[1].arg_ptr.arg_stab == defstab ) {
  90.     switch (pat->arg_type) {
  91.     case O_MATCH:
  92.         newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
  93.         pat->arg_len,
  94.         left,Nullarg,Nullarg);
  95.         break;
  96.     case O_SUBST:
  97.         newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
  98.         pat->arg_len,
  99.         left,Nullarg,Nullarg));
  100.         break;
  101.     case O_TRANS:
  102.         newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
  103.         pat->arg_len,
  104.         left,Nullarg,Nullarg));
  105.         break;
  106.     case O_SPLIT:
  107.         newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
  108.         pat->arg_len,
  109.         left,Nullarg,Nullarg);
  110.         break;
  111.     }
  112.     if (pat->arg_len >= 2) {
  113.         newarg[2].arg_type = pat[2].arg_type;
  114.         newarg[2].arg_ptr = pat[2].arg_ptr;
  115.         newarg[2].arg_len = pat[2].arg_len;
  116.         newarg[2].arg_flags = pat[2].arg_flags;
  117.         if (pat->arg_len >= 3) {
  118.         newarg[3].arg_type = pat[3].arg_type;
  119.         newarg[3].arg_ptr = pat[3].arg_ptr;
  120.         newarg[3].arg_len = pat[3].arg_len;
  121.         newarg[3].arg_flags = pat[3].arg_flags;
  122.         }
  123.     }
  124.     free_arg(pat);
  125.     }
  126.     else {
  127.     Newz(202,spat,1,SPAT);
  128.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  129.     curstash->tbl_spatroot = spat;
  130.  
  131.     spat->spat_runtime = pat;
  132.     newarg = make_op(type,2,left,Nullarg,Nullarg);
  133.     newarg[2].arg_type = A_SPAT | A_DONT;
  134.     newarg[2].arg_ptr.arg_spat = spat;
  135.     }
  136.  
  137.     return newarg;
  138. }
  139.  
  140. ARG *
  141. make_op(type,newlen,arg1,arg2,arg3)
  142. int type;
  143. int newlen;
  144. ARG *arg1;
  145. ARG *arg2;
  146. ARG *arg3;
  147. {
  148.     register ARG *arg;
  149.     register ARG *chld;
  150.     register unsigned doarg;
  151.     register int i;
  152.     extern ARG *arg4;    /* should be normal arguments, really */
  153.     extern ARG *arg5;
  154.  
  155.     arg = op_new(newlen);
  156.     arg->arg_type = type;
  157.     if (chld = arg1) {
  158.     if (chld->arg_type == O_ITEM &&
  159.         (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
  160.          (i == A_LEXPR &&
  161.           (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  162.            chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  163.            chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
  164.     {
  165.         arg[1].arg_type = chld[1].arg_type;
  166.         arg[1].arg_ptr = chld[1].arg_ptr;
  167.         arg[1].arg_flags |= chld[1].arg_flags;
  168.         arg[1].arg_len = chld[1].arg_len;
  169.         free_arg(chld);
  170.     }
  171.     else {
  172.         arg[1].arg_type = A_EXPR;
  173.         arg[1].arg_ptr.arg_arg = chld;
  174.     }
  175.     }
  176.     if (chld = arg2) {
  177.     if (chld->arg_type == O_ITEM &&
  178.         (hoistable[chld[1].arg_type&A_MASK] ||
  179.          (type == O_ASSIGN &&
  180.           ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  181.         ||
  182.            (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
  183.         ||
  184.            (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
  185.           ) ) ) ) {
  186.         arg[2].arg_type = chld[1].arg_type;
  187.         arg[2].arg_ptr = chld[1].arg_ptr;
  188.         arg[2].arg_len = chld[1].arg_len;
  189.         free_arg(chld);
  190.     }
  191.     else {
  192.         arg[2].arg_type = A_EXPR;
  193.         arg[2].arg_ptr.arg_arg = chld;
  194.     }
  195.     }
  196.     if (chld = arg3) {
  197.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  198.         arg[3].arg_type = chld[1].arg_type;
  199.         arg[3].arg_ptr = chld[1].arg_ptr;
  200.         arg[3].arg_len = chld[1].arg_len;
  201.         free_arg(chld);
  202.     }
  203.     else {
  204.         arg[3].arg_type = A_EXPR;
  205.         arg[3].arg_ptr.arg_arg = chld;
  206.     }
  207.     }
  208.     if (newlen >= 4 && (chld = arg4)) {
  209.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  210.         arg[4].arg_type = chld[1].arg_type;
  211.         arg[4].arg_ptr = chld[1].arg_ptr;
  212.         arg[4].arg_len = chld[1].arg_len;
  213.         free_arg(chld);
  214.     }
  215.     else {
  216.         arg[4].arg_type = A_EXPR;
  217.         arg[4].arg_ptr.arg_arg = chld;
  218.     }
  219.     }
  220.     if (newlen >= 5 && (chld = arg5)) {
  221.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  222.         arg[5].arg_type = chld[1].arg_type;
  223.         arg[5].arg_ptr = chld[1].arg_ptr;
  224.         arg[5].arg_len = chld[1].arg_len;
  225.         free_arg(chld);
  226.     }
  227.     else {
  228.         arg[5].arg_type = A_EXPR;
  229.         arg[5].arg_ptr.arg_arg = chld;
  230.     }
  231.     }
  232.     doarg = opargs[type];
  233.     for (i = 1; i <= newlen; ++i) {
  234.     if (!(doarg & 1))
  235.         arg[i].arg_type |= A_DONT;
  236.     if (doarg & 2)
  237.         arg[i].arg_flags |= AF_ARYOK;
  238.     doarg >>= 2;
  239.     }
  240. #ifdef DEBUGGING
  241.     if (debug & 16) {
  242.     fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
  243.     if (arg1)
  244.         fprintf(stderr,",%s=%lx",
  245.         argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
  246.     if (arg2)
  247.         fprintf(stderr,",%s=%lx",
  248.         argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
  249.     if (arg3)
  250.         fprintf(stderr,",%s=%lx",
  251.         argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
  252.     if (newlen >= 4)
  253.         fprintf(stderr,",%s=%lx",
  254.         argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
  255.     if (newlen >= 5)
  256.         fprintf(stderr,",%s=%lx",
  257.         argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
  258.     fprintf(stderr,")\n");
  259.     }
  260. #endif
  261.     arg = evalstatic(arg);    /* see if we can consolidate anything */
  262.     return arg;
  263. }
  264.  
  265. ARG *
  266. evalstatic(arg)
  267. register ARG *arg;
  268. {
  269.     static STR *str = Nullstr;
  270.     register STR *s1;
  271.     register STR *s2;
  272.     double value;        /* must not be register */
  273.     register char *tmps;
  274.     int i;
  275.     unsigned long tmplong;
  276.     long tmp2;
  277.     double exp(), log(), sqrt(), modf();
  278.     char *crypt();
  279.     double sin(), cos(), atan2(), pow();
  280.  
  281.     if (!arg || !arg->arg_len)
  282.     return arg;
  283.  
  284.     if (!str)
  285.     str = Str_new(20,0);
  286.  
  287.     if (arg[1].arg_type == A_SINGLE)
  288.     s1 = arg[1].arg_ptr.arg_str;
  289.     else
  290.     s1 = Nullstr;
  291.     if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
  292.     s2 = arg[2].arg_ptr.arg_str;
  293.     else
  294.     s2 = Nullstr;
  295.  
  296. #define CHECK1 if (!s1) return arg
  297. #define CHECK2 if (!s2) return arg
  298. #define CHECK12 if (!s1 || !s2) return arg
  299.  
  300.     switch (arg->arg_type) {
  301.     default:
  302.     return arg;
  303.     case O_AELEM:
  304.     CHECK2;
  305.     i = (int)str_gnum(s2);
  306.     if (i < 32767 && i >= 0) {
  307.         arg->arg_type = O_ITEM;
  308.         arg->arg_len = 1;
  309.         arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
  310.         arg[1].arg_len = i;
  311.         str_free(s2);
  312.         Renew(arg, 2, ARG);
  313.     }
  314.     return arg;
  315.     case O_CONCAT:
  316.     CHECK12;
  317.     str_sset(str,s1);
  318.     str_scat(str,s2);
  319.     break;
  320.     case O_REPEAT:
  321.     CHECK12;
  322.     i = (int)str_gnum(s2);
  323.     tmps = str_get(s1);
  324.     str_nset(str,"",0);
  325.     STR_GROW(str, i * s1->str_cur + 1);
  326.     repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
  327.     str->str_cur = i * s1->str_cur;
  328.     str->str_ptr[str->str_cur] = '\0';
  329.     break;
  330.     case O_MULTIPLY:
  331.     CHECK12;
  332.     value = str_gnum(s1);
  333.     str_numset(str,value * str_gnum(s2));
  334.     break;
  335.     case O_DIVIDE:
  336.     CHECK12;
  337.     value = str_gnum(s2);
  338.     if (value == 0.0)
  339.         yyerror("Illegal division by constant zero");
  340.     else
  341. #ifdef cray
  342.     /* insure that 20./5. == 4. */
  343.     {
  344.         double x;
  345.         int    k;
  346.         x =  str_gnum(s1);
  347.         if ((double)(int)x     == x &&
  348.         (double)(int)value == value &&
  349.         (k = (int)x/(int)value)*(int)value == (int)x) {
  350.         value = k;
  351.         } else {
  352.         value = x/value;
  353.         }
  354.         str_numset(str,value);
  355.     }
  356. #else
  357.     str_numset(str,str_gnum(s1) / value);
  358. #endif
  359.     break;
  360.     case O_MODULO:
  361.     CHECK12;
  362.     tmplong = (unsigned long)str_gnum(s2);
  363.     if (tmplong == 0L) {
  364.         yyerror("Illegal modulus of constant zero");
  365.         return arg;
  366.     }
  367.     tmp2 = (long)str_gnum(s1);
  368. #ifndef lint
  369.     if (tmp2 >= 0)
  370.         str_numset(str,(double)(tmp2 % tmplong));
  371.     else
  372.         str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  373. #else
  374.     tmp2 = tmp2;
  375. #endif
  376.     break;
  377.     case O_ADD:
  378.     CHECK12;
  379.     value = str_gnum(s1);
  380.     str_numset(str,value + str_gnum(s2));
  381.     break;
  382.     case O_SUBTRACT:
  383.     CHECK12;
  384.     value = str_gnum(s1);
  385.     str_numset(str,value - str_gnum(s2));
  386.     break;
  387.     case O_LEFT_SHIFT:
  388.     CHECK12;
  389.     value = str_gnum(s1);
  390.     i = (int)str_gnum(s2);
  391. #ifndef lint
  392.     str_numset(str,(double)(((long)value) << i));
  393. #endif
  394.     break;
  395.     case O_RIGHT_SHIFT:
  396.     CHECK12;
  397.     value = str_gnum(s1);
  398.     i = (int)str_gnum(s2);
  399. #ifndef lint
  400.     str_numset(str,(double)(((long)value) >> i));
  401. #endif
  402.     break;
  403.     case O_LT:
  404.     CHECK12;
  405.     value = str_gnum(s1);
  406.     str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
  407.     break;
  408.     case O_GT:
  409.     CHECK12;
  410.     value = str_gnum(s1);
  411.     str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
  412.     break;
  413.     case O_LE:
  414.     CHECK12;
  415.     value = str_gnum(s1);
  416.     str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
  417.     break;
  418.     case O_GE:
  419.     CHECK12;
  420.     value = str_gnum(s1);
  421.     str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
  422.     break;
  423.     case O_EQ:
  424.     CHECK12;
  425.     if (dowarn) {
  426.         if ((!s1->str_nok && !looks_like_number(s1)) ||
  427.         (!s2->str_nok && !looks_like_number(s2)) )
  428.         warn("Possible use of == on string value");
  429.     }
  430.     value = str_gnum(s1);
  431.     str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
  432.     break;
  433.     case O_NE:
  434.     CHECK12;
  435.     value = str_gnum(s1);
  436.     str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
  437.     break;
  438.     case O_NCMP:
  439.     CHECK12;
  440.     value = str_gnum(s1);
  441.     value -= str_gnum(s2);
  442.     if (value > 0.0)
  443.         value = 1.0;
  444.     else if (value < 0.0)
  445.         value = -1.0;
  446.     str_numset(str,value);
  447.     break;
  448.     case O_BIT_AND:
  449.     CHECK12;
  450.     value = str_gnum(s1);
  451. #ifndef lint
  452.     str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  453. #endif
  454.     break;
  455.     case O_XOR:
  456.     CHECK12;
  457.     value = str_gnum(s1);
  458. #ifndef lint
  459.     str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  460. #endif
  461.     break;
  462.     case O_BIT_OR:
  463.     CHECK12;
  464.     value = str_gnum(s1);
  465. #ifndef lint
  466.     str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  467. #endif
  468.     break;
  469.     case O_AND:
  470.     CHECK12;
  471.     if (str_true(s1))
  472.         str_sset(str,s2);
  473.     else
  474.         str_sset(str,s1);
  475.     break;
  476.     case O_OR:
  477.     CHECK12;
  478.     if (str_true(s1))
  479.         str_sset(str,s1);
  480.     else
  481.         str_sset(str,s2);
  482.     break;
  483.     case O_COND_EXPR:
  484.     CHECK12;
  485.     if ((arg[3].arg_type & A_MASK) != A_SINGLE)
  486.         return arg;
  487.     if (str_true(s1))
  488.         str_sset(str,s2);
  489.     else
  490.         str_sset(str,arg[3].arg_ptr.arg_str);
  491.     str_free(arg[3].arg_ptr.arg_str);
  492.     Renew(arg, 3, ARG);
  493.     break;
  494.     case O_NEGATE:
  495.     CHECK1;
  496.     str_numset(str,(double)(-str_gnum(s1)));
  497.     break;
  498.     case O_NOT:
  499.     CHECK1;
  500.     str_numset(str,(double)(!str_true(s1)));
  501.     break;
  502.     case O_COMPLEMENT:
  503.     CHECK1;
  504. #ifndef lint
  505.     str_numset(str,(double)(~U_L(str_gnum(s1))));
  506. #endif
  507.     break;
  508.     case O_SIN:
  509.     CHECK1;
  510.     str_numset(str,sin(str_gnum(s1)));
  511.     break;
  512.     case O_COS:
  513.     CHECK1;
  514.     str_numset(str,cos(str_gnum(s1)));
  515.     break;
  516.     case O_ATAN2:
  517.     CHECK12;
  518.     value = str_gnum(s1);
  519.     str_numset(str,atan2(value, str_gnum(s2)));
  520.     break;
  521.     case O_POW:
  522.     CHECK12;
  523.     value = str_gnum(s1);
  524.     str_numset(str,pow(value, str_gnum(s2)));
  525.     break;
  526.     case O_LENGTH:
  527.     if (arg[1].arg_type == A_STAB) {
  528.         arg->arg_type = O_ITEM;
  529.         arg[1].arg_type = A_LENSTAB;
  530.         return arg;
  531.     }
  532.     CHECK1;
  533.     str_numset(str, (double)str_len(s1));
  534.     break;
  535.     case O_SLT:
  536.     CHECK12;
  537.     str_numset(str,(double)(str_cmp(s1,s2) < 0));
  538.     break;
  539.     case O_SGT:
  540.     CHECK12;
  541.     str_numset(str,(double)(str_cmp(s1,s2) > 0));
  542.     break;
  543.     case O_SLE:
  544.     CHECK12;
  545.     str_numset(str,(double)(str_cmp(s1,s2) <= 0));
  546.     break;
  547.     case O_SGE:
  548.     CHECK12;
  549.     str_numset(str,(double)(str_cmp(s1,s2) >= 0));
  550.     break;
  551.     case O_SEQ:
  552.     CHECK12;
  553.     str_numset(str,(double)(str_eq(s1,s2)));
  554.     break;
  555.     case O_SNE:
  556.     CHECK12;
  557.     str_numset(str,(double)(!str_eq(s1,s2)));
  558.     break;
  559.     case O_SCMP:
  560.     CHECK12;
  561.     str_numset(str,(double)(str_cmp(s1,s2)));
  562.     break;
  563.     case O_CRYPT:
  564.     CHECK12;
  565. #ifdef HAS_CRYPT
  566.     tmps = str_get(s1);
  567.     str_set(str,crypt(tmps,str_get(s2)));
  568. #else
  569.     yyerror(
  570.     "The crypt() function is unimplemented due to excessive paranoia.");
  571. #endif
  572.     break;
  573.     case O_EXP:
  574.     CHECK1;
  575.     str_numset(str,exp(str_gnum(s1)));
  576.     break;
  577.     case O_LOG:
  578.     CHECK1;
  579.     str_numset(str,log(str_gnum(s1)));
  580.     break;
  581.     case O_SQRT:
  582.     CHECK1;
  583.     str_numset(str,sqrt(str_gnum(s1)));
  584.     break;
  585.     case O_INT:
  586.     CHECK1;
  587.     value = str_gnum(s1);
  588.     if (value >= 0.0)
  589.         (void)modf(value,&value);
  590.     else {
  591.         (void)modf(-value,&value);
  592.         value = -value;
  593.     }
  594.     str_numset(str,value);
  595.     break;
  596.     case O_ORD:
  597.     CHECK1;
  598. #ifndef I286
  599.     str_numset(str,(double)(*str_get(s1)));
  600. #else
  601.     {
  602.         int  zapc;
  603.         char *zaps;
  604.  
  605.         zaps = str_get(s1);
  606.         zapc = (int) *zaps;
  607.         str_numset(str,(double)(zapc));
  608.     }
  609. #endif
  610.     break;
  611.     }
  612.     arg->arg_type = O_ITEM;    /* note arg1 type is already SINGLE */
  613.     str_free(s1);
  614.     arg[1].arg_ptr.arg_str = str;
  615.     if (s2) {
  616.     str_free(s2);
  617.     arg[2].arg_ptr.arg_str = Nullstr;
  618.     arg[2].arg_type = A_NULL;
  619.     }
  620.     str = Nullstr;
  621.  
  622.     return arg;
  623. }
  624.  
  625. ARG *
  626. l(arg)
  627. register ARG *arg;
  628. {
  629.     register int i;
  630.     register ARG *arg1;
  631.     register ARG *arg2;
  632.     SPAT *spat;
  633.     int arghog = 0;
  634.  
  635.     i = arg[1].arg_type & A_MASK;
  636.  
  637.     arg->arg_flags |= AF_COMMON;    /* assume something in common */
  638.                     /* which forces us to copy things */
  639.  
  640.     if (i == A_ARYLEN) {
  641.     arg[1].arg_type = A_LARYLEN;
  642.     return arg;
  643.     }
  644.     if (i == A_ARYSTAB) {
  645.     arg[1].arg_type = A_LARYSTAB;
  646.     return arg;
  647.     }
  648.  
  649.     /* see if it's an array reference */
  650.  
  651.     if (i == A_EXPR || i == A_LEXPR) {
  652.     arg1 = arg[1].arg_ptr.arg_arg;
  653.  
  654.     if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
  655.                         /* assign to list */
  656.         if (arg->arg_len > 1) {
  657.         dehoist(arg,2);
  658.         arg2 = arg[2].arg_ptr.arg_arg;
  659.         if (nothing_in_common(arg1,arg2))
  660.             arg->arg_flags &= ~AF_COMMON;
  661.         if (arg->arg_type == O_ASSIGN) {
  662.             if (arg1->arg_flags & AF_LOCAL)
  663.             arg->arg_flags |= AF_LOCAL;
  664.             arg[1].arg_flags |= AF_ARYOK;
  665.             arg[2].arg_flags |= AF_ARYOK;
  666.         }
  667.         }
  668.         else if (arg->arg_type != O_CHOP)
  669.         arg->arg_type = O_ASSIGN;    /* possible local(); */
  670.         for (i = arg1->arg_len; i >= 1; i--) {
  671.         switch (arg1[i].arg_type) {
  672.         case A_STAR: case A_LSTAR:
  673.             arg1[i].arg_type = A_LSTAR;
  674.             break;
  675.         case A_STAB: case A_LVAL:
  676.             arg1[i].arg_type = A_LVAL;
  677.             break;
  678.         case A_ARYLEN: case A_LARYLEN:
  679.             arg1[i].arg_type = A_LARYLEN;
  680.             break;
  681.         case A_ARYSTAB: case A_LARYSTAB:
  682.             arg1[i].arg_type = A_LARYSTAB;
  683.             break;
  684.         case A_EXPR: case A_LEXPR:
  685.             arg1[i].arg_type = A_LEXPR;
  686.             switch(arg1[i].arg_ptr.arg_arg->arg_type) {
  687.             case O_ARRAY: case O_LARRAY:
  688.             arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
  689.             arghog = 1;
  690.             break;
  691.             case O_AELEM: case O_LAELEM:
  692.             arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
  693.             break;
  694.             case O_HASH: case O_LHASH:
  695.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
  696.             arghog = 1;
  697.             break;
  698.             case O_HELEM: case O_LHELEM:
  699.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
  700.             break;
  701.             case O_ASLICE: case O_LASLICE:
  702.             arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
  703.             break;
  704.             case O_HSLICE: case O_LHSLICE:
  705.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
  706.             break;
  707.             default:
  708.             goto ill_item;
  709.             }
  710.             break;
  711.         default:
  712.           ill_item:
  713.             (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
  714.               argname[arg1[i].arg_type&A_MASK]);
  715.             yyerror(tokenbuf);
  716.         }
  717.         }
  718.         if (arg->arg_len > 1) {
  719.         if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
  720.             arg2[3].arg_type = A_SINGLE;
  721.             arg2[3].arg_ptr.arg_str =
  722.               str_nmake((double)arg1->arg_len + 1); /* limit split len*/
  723.         }
  724.         }
  725.     }
  726.     else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
  727.         if (arg->arg_type == O_DEFINED)
  728.         arg1->arg_type = O_AELEM;
  729.         else
  730.         arg1->arg_type = O_LAELEM;
  731.     else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
  732.         arg1->arg_type = O_LARRAY;
  733.         if (arg->arg_len > 1) {
  734.         dehoist(arg,2);
  735.         arg2 = arg[2].arg_ptr.arg_arg;
  736.         if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
  737.             spat = arg2[2].arg_ptr.arg_spat;
  738.             if (!(spat->spat_flags & SPAT_ONCE) &&
  739.               nothing_in_common(arg1,spat->spat_repl)) {
  740.             spat->spat_repl[1].arg_ptr.arg_stab =
  741.                 arg1[1].arg_ptr.arg_stab;
  742.             arg1[1].arg_ptr.arg_stab = Nullstab;
  743.             spat->spat_flags |= SPAT_ONCE;
  744.             arg_free(arg1);    /* recursive */
  745.             arg[1].arg_ptr.arg_arg = Nullarg;
  746.             free_arg(arg);    /* non-recursive */
  747.             return arg2;    /* split has builtin assign */
  748.             }
  749.         }
  750.         else if (nothing_in_common(arg1,arg2))
  751.             arg->arg_flags &= ~AF_COMMON;
  752.         if (arg->arg_type == O_ASSIGN) {
  753.             arg[1].arg_flags |= AF_ARYOK;
  754.             arg[2].arg_flags |= AF_ARYOK;
  755.         }
  756.         }
  757.         else if (arg->arg_type == O_ASSIGN)
  758.         arg[1].arg_flags |= AF_ARYOK;
  759.     }
  760.     else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
  761.         if (arg->arg_type == O_DEFINED)
  762.         arg1->arg_type = O_HELEM;    /* avoid creating one */
  763.         else
  764.         arg1->arg_type = O_LHELEM;
  765.     else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
  766.         arg1->arg_type = O_LHASH;
  767.         if (arg->arg_len > 1) {
  768.         dehoist(arg,2);
  769.         arg2 = arg[2].arg_ptr.arg_arg;
  770.         if (nothing_in_common(arg1,arg2))
  771.             arg->arg_flags &= ~AF_COMMON;
  772.         if (arg->arg_type == O_ASSIGN) {
  773.             arg[1].arg_flags |= AF_ARYOK;
  774.             arg[2].arg_flags |= AF_ARYOK;
  775.         }
  776.         }
  777.         else if (arg->arg_type == O_ASSIGN)
  778.         arg[1].arg_flags |= AF_ARYOK;
  779.     }
  780.     else if (arg1->arg_type == O_ASLICE) {
  781.         arg1->arg_type = O_LASLICE;
  782.         if (arg->arg_type == O_ASSIGN) {
  783.         dehoist(arg,2);
  784.         arg[1].arg_flags |= AF_ARYOK;
  785.         arg[2].arg_flags |= AF_ARYOK;
  786.         }
  787.     }
  788.     else if (arg1->arg_type == O_HSLICE) {
  789.         arg1->arg_type = O_LHSLICE;
  790.         if (arg->arg_type == O_ASSIGN) {
  791.         dehoist(arg,2);
  792.         arg[1].arg_flags |= AF_ARYOK;
  793.         arg[2].arg_flags |= AF_ARYOK;
  794.         }
  795.     }
  796.     else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
  797.       (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
  798.         arg[1].arg_type |= A_DONT;
  799.     }
  800.     else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
  801.         (void)l(arg1);
  802.         Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
  803.             /* grow string struct to hold an lstring struct */
  804.     }
  805.     else if (arg1->arg_type == O_ASSIGN) {
  806. /*        if (arg->arg_type == O_CHOP)
  807.         arg[1].arg_flags &= ~AF_ARYOK;    /* grandfather chop idiom */
  808.     }
  809.     else {
  810.         (void)sprintf(tokenbuf,
  811.           "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
  812.         yyerror(tokenbuf);
  813.     }
  814.     arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
  815.     if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
  816.         arg[1].arg_flags |= AF_ARYOK;
  817.         if (arg->arg_len > 1)
  818.         arg[2].arg_flags |= AF_ARYOK;
  819.     }
  820. #ifdef DEBUGGING
  821.     if (debug & 16)
  822.         fprintf(stderr,"lval LEXPR\n");
  823. #endif
  824.     return arg;
  825.     }
  826.     if (i == A_STAR || i == A_LSTAR) {
  827.     arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
  828.     return arg;
  829.     }
  830.  
  831.     /* not an array reference, should be a register name */
  832.  
  833.     if (i != A_STAB && i != A_LVAL) {
  834.     (void)sprintf(tokenbuf,
  835.       "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
  836.     yyerror(tokenbuf);
  837.     }
  838.     arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
  839. #ifdef DEBUGGING
  840.     if (debug & 16)
  841.     fprintf(stderr,"lval LVAL\n");
  842. #endif
  843.     return arg;
  844. }
  845.  
  846. ARG *
  847. fixl(type,arg)
  848. int type;
  849. ARG *arg;
  850. {
  851.     if (type == O_DEFINED || type == O_UNDEF) {
  852.     if (arg->arg_type != O_ITEM)
  853.         arg = hide_ary(arg);
  854.     if (arg->arg_type == O_ITEM) {
  855.         type = arg[1].arg_type & A_MASK;
  856.         if (type == A_EXPR || type == A_LEXPR)
  857.         arg[1].arg_type = A_LEXPR|A_DONT;
  858.     }
  859.     }
  860.     return arg;
  861. }
  862.  
  863. dehoist(arg,i)
  864. ARG *arg;
  865. {
  866.     ARG *tmparg;
  867.  
  868.     if (arg[i].arg_type != A_EXPR) {    /* dehoist */
  869.     tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
  870.     tmparg[1] = arg[i];
  871.     arg[i].arg_ptr.arg_arg = tmparg;
  872.     arg[i].arg_type = A_EXPR;
  873.     }
  874. }
  875.  
  876. ARG *
  877. addflags(i,flags,arg)
  878. register ARG *arg;
  879. {
  880.     arg[i].arg_flags |= flags;
  881.     return arg;
  882. }
  883.  
  884. ARG *
  885. hide_ary(arg)
  886. ARG *arg;
  887. {
  888.     if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
  889.     return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
  890.     return arg;
  891. }
  892.  
  893. /* maybe do a join on multiple array dimensions */
  894.  
  895. ARG *
  896. jmaybe(arg)
  897. register ARG *arg;
  898. {
  899.     if (arg && arg->arg_type == O_COMMA) {
  900.     arg = listish(arg);
  901.     arg = make_op(O_JOIN, 2,
  902.         stab2arg(A_STAB,stabent(";",TRUE)),
  903.         make_list(arg),
  904.         Nullarg);
  905.     }
  906.     return arg;
  907. }
  908.  
  909. ARG *
  910. make_list(arg)
  911. register ARG *arg;
  912. {
  913.     register int i;
  914.     register ARG *node;
  915.     register ARG *nxtnode;
  916.     register int j;
  917.     STR *tmpstr;
  918.  
  919.     if (!arg) {
  920.     arg = op_new(0);
  921.     arg->arg_type = O_LIST;
  922.     }
  923.     if (arg->arg_type != O_COMMA) {
  924.     if (arg->arg_type != O_ARRAY)
  925.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  926.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  927.     return arg;
  928.     }
  929.     for (i = 2, node = arg; ; i++) {
  930.     if (node->arg_len < 2)
  931.         break;
  932.         if (node[1].arg_type != A_EXPR)
  933.         break;
  934.     node = node[1].arg_ptr.arg_arg;
  935.     if (node->arg_type != O_COMMA)
  936.         break;
  937.     }
  938.     if (i > 2) {
  939.     node = arg;
  940.     arg = op_new(i);
  941.     tmpstr = arg->arg_ptr.arg_str;
  942. #ifdef STRUCTCOPY
  943.     *arg = *node;        /* copy everything except the STR */
  944. #else
  945.     (void)bcopy((char *)node, (char *)arg, sizeof(ARG));
  946. #endif
  947.     arg->arg_ptr.arg_str = tmpstr;
  948.     for (j = i; ; ) {
  949. #ifdef STRUCTCOPY
  950.         arg[j] = node[2];
  951. #else
  952.         (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
  953. #endif
  954.         arg[j].arg_flags |= AF_ARYOK;
  955.         --j;        /* Bug in Xenix compiler */
  956.         if (j < 2) {
  957. #ifdef STRUCTCOPY
  958.         arg[1] = node[1];
  959. #else
  960.         (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
  961. #endif
  962.         free_arg(node);
  963.         break;
  964.         }
  965.         nxtnode = node[1].arg_ptr.arg_arg;
  966.         free_arg(node);
  967.         node = nxtnode;
  968.     }
  969.     }
  970.     arg[1].arg_flags |= AF_ARYOK;
  971.     arg[2].arg_flags |= AF_ARYOK;
  972.     arg->arg_type = O_LIST;
  973.     arg->arg_len = i;
  974.     return arg;
  975. }
  976.  
  977. /* turn a single item into a list */
  978.  
  979. ARG *
  980. listish(arg)
  981. ARG *arg;
  982. {
  983.     if (arg->arg_flags & AF_LISTISH)
  984.     arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
  985.     return arg;
  986. }
  987.  
  988. ARG *
  989. maybelistish(optype, arg)
  990. int optype;
  991. ARG *arg;
  992. {
  993.     ARG *tmparg = arg;
  994.  
  995.     if (optype == O_RETURN && arg->arg_type == O_ITEM &&
  996.       arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
  997.       ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
  998.     tmparg = listish(tmparg);
  999.     free_arg(arg);
  1000.     arg = tmparg;
  1001.     }
  1002.     else if (optype == O_PRTF ||
  1003.       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
  1004.        arg->arg_type == O_F_OR_R) )
  1005.     arg = listish(arg);
  1006.     return arg;
  1007. }
  1008.  
  1009. /* mark list of local variables */
  1010.  
  1011. ARG *
  1012. localize(arg)
  1013. ARG *arg;
  1014. {
  1015.     arg->arg_flags |= AF_LOCAL;
  1016.     return arg;
  1017. }
  1018.  
  1019. ARG *
  1020. rcatmaybe(arg)
  1021. ARG *arg;
  1022. {
  1023.     ARG *arg2;
  1024.  
  1025.     if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
  1026.     arg2 = arg[2].arg_ptr.arg_arg;
  1027.     if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
  1028.         arg->arg_type = O_RCAT;
  1029.         arg[2].arg_type = arg2[1].arg_type;
  1030.         arg[2].arg_ptr = arg2[1].arg_ptr;
  1031.         free_arg(arg2);
  1032.     }
  1033.     }
  1034.     return arg;
  1035. }
  1036.  
  1037. ARG *
  1038. stab2arg(atype,stab)
  1039. int atype;
  1040. register STAB *stab;
  1041. {
  1042.     register ARG *arg;
  1043.  
  1044.     arg = op_new(1);
  1045.     arg->arg_type = O_ITEM;
  1046.     arg[1].arg_type = atype;
  1047.     arg[1].arg_ptr.arg_stab = stab;
  1048.     return arg;
  1049. }
  1050.  
  1051. ARG *
  1052. cval_to_arg(cval)
  1053. register char *cval;
  1054. {
  1055.     register ARG *arg;
  1056.  
  1057.     arg = op_new(1);
  1058.     arg->arg_type = O_ITEM;
  1059.     arg[1].arg_type = A_SINGLE;
  1060.     arg[1].arg_ptr.arg_str = str_make(cval,0);
  1061.     Safefree(cval);
  1062.     return arg;
  1063. }
  1064.  
  1065. ARG *
  1066. op_new(numargs)
  1067. int numargs;
  1068. {
  1069.     register ARG *arg;
  1070.  
  1071.     Newz(203,arg, numargs + 1, ARG);
  1072.     arg->arg_ptr.arg_str = Str_new(21,0);
  1073.     arg->arg_len = numargs;
  1074.     return arg;
  1075. }
  1076.  
  1077. void
  1078. free_arg(arg)
  1079. ARG *arg;
  1080. {
  1081.     str_free(arg->arg_ptr.arg_str);
  1082.     Safefree(arg);
  1083. }
  1084.  
  1085. ARG *
  1086. make_match(type,expr,spat)
  1087. int type;
  1088. ARG *expr;
  1089. SPAT *spat;
  1090. {
  1091.     register ARG *arg;
  1092.  
  1093.     arg = make_op(type,2,expr,Nullarg,Nullarg);
  1094.  
  1095.     arg[2].arg_type = A_SPAT|A_DONT;
  1096.     arg[2].arg_ptr.arg_spat = spat;
  1097. #ifdef DEBUGGING
  1098.     if (debug & 16)
  1099.     fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
  1100. #endif
  1101.  
  1102.     if (type == O_SUBST || type == O_NSUBST) {
  1103.     if (arg[1].arg_type != A_STAB) {
  1104.         yyerror("Illegal lvalue");
  1105.     }
  1106.     arg[1].arg_type = A_LVAL;
  1107.     }
  1108.     return arg;
  1109. }
  1110.  
  1111. ARG *
  1112. cmd_to_arg(cmd)
  1113. CMD *cmd;
  1114. {
  1115.     register ARG *arg;
  1116.  
  1117.     arg = op_new(1);
  1118.     arg->arg_type = O_ITEM;
  1119.     arg[1].arg_type = A_CMD;
  1120.     arg[1].arg_ptr.arg_cmd = cmd;
  1121.     return arg;
  1122. }
  1123.  
  1124. /* Check two expressions to see if there is any identifier in common */
  1125.  
  1126. static int
  1127. nothing_in_common(arg1,arg2)
  1128. ARG *arg1;
  1129. ARG *arg2;
  1130. {
  1131.     static int thisexpr = 0;    /* I don't care if this wraps */
  1132.  
  1133.     thisexpr++;
  1134.     if (arg_common(arg1,thisexpr,1))
  1135.     return 0;    /* hit eval or do {} */
  1136.     stab_lastexpr(defstab) = thisexpr;        /* pretend to hit @_ */
  1137.     if (arg_common(arg2,thisexpr,0))
  1138.     return 0;    /* hit identifier again */
  1139.     return 1;
  1140. }
  1141.  
  1142. /* Recursively descend an expression and mark any identifier or check
  1143.  * it to see if it was marked already.
  1144.  */
  1145.  
  1146. static int
  1147. arg_common(arg,exprnum,marking)
  1148. register ARG *arg;
  1149. int exprnum;
  1150. int marking;
  1151. {
  1152.     register int i;
  1153.  
  1154.     if (!arg)
  1155.     return 0;
  1156.     for (i = arg->arg_len; i >= 1; i--) {
  1157.     switch (arg[i].arg_type & A_MASK) {
  1158.     case A_NULL:
  1159.         break;
  1160.     case A_LEXPR:
  1161.     case A_EXPR:
  1162.         if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
  1163.         return 1;
  1164.         break;
  1165.     case A_CMD:
  1166.         return 1;        /* assume hanky panky */
  1167.     case A_STAR:
  1168.     case A_LSTAR:
  1169.     case A_STAB:
  1170.     case A_LVAL:
  1171.     case A_ARYLEN:
  1172.     case A_LARYLEN:
  1173.         if (marking)
  1174.         stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
  1175.         else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
  1176.         return 1;
  1177.         break;
  1178.     case A_DOUBLE:
  1179.     case A_BACKTICK:
  1180.         {
  1181.         register char *s = arg[i].arg_ptr.arg_str->str_ptr;
  1182.         register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
  1183.         register STAB *stab;
  1184.  
  1185.         while (*s) {
  1186.             if (*s == '$' && s[1]) {
  1187.             s = scanident(s,send,tokenbuf);
  1188.             stab = stabent(tokenbuf,TRUE);
  1189.             if (marking)
  1190.                 stab_lastexpr(stab) = exprnum;
  1191.             else if (stab_lastexpr(stab) == exprnum)
  1192.                 return 1;
  1193.             continue;
  1194.             }
  1195.             else if (*s == '\\' && s[1])
  1196.             s++;
  1197.             s++;
  1198.         }
  1199.         }
  1200.         break;
  1201.     case A_SPAT:
  1202.         if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
  1203.         return 1;
  1204.         break;
  1205.     case A_READ:
  1206.     case A_INDREAD:
  1207.     case A_GLOB:
  1208.     case A_WORD:
  1209.     case A_SINGLE:
  1210.         break;
  1211.     }
  1212.     }
  1213.     switch (arg->arg_type) {
  1214.     case O_ARRAY:
  1215.     case O_LARRAY:
  1216.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1217.         (void)aadd(arg[1].arg_ptr.arg_stab);
  1218.     break;
  1219.     case O_HASH:
  1220.     case O_LHASH:
  1221.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1222.         (void)hadd(arg[1].arg_ptr.arg_stab);
  1223.     break;
  1224.     case O_EVAL:
  1225.     case O_SUBR:
  1226.     case O_DBSUBR:
  1227.     return 1;
  1228.     }
  1229.     return 0;
  1230. }
  1231.  
  1232. static int
  1233. spat_common(spat,exprnum,marking)
  1234. register SPAT *spat;
  1235. int exprnum;
  1236. int marking;
  1237. {
  1238.     if (spat->spat_runtime)
  1239.     if (arg_common(spat->spat_runtime,exprnum,marking))
  1240.         return 1;
  1241.     if (spat->spat_repl) {
  1242.     if (arg_common(spat->spat_repl,exprnum,marking))
  1243.         return 1;
  1244.     }
  1245.     return 0;
  1246. }
  1247.